home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / fpkpas92.zip / FVSRC.ZIP / FV / SOURCE / OBJECTS.PP < prev   
Text File  |  1997-07-01  |  95KB  |  1,972 lines
  1. {**********[ SOURCE FILE OF FREE VISION ]***************}
  2. {                                                       }
  3. {   Parts Copyright (c) 1992,96 by Florian Klaempfl     }
  4. {   fnklaemp@cip.ft.uni-erlangen.de                     }
  5. {                                                       }
  6. {   Parts Copyright (c) 1996 by Frank ZAGO              }
  7. {   zago@ecoledoc.ipc.fr                                }
  8. {                                                       }
  9. {   Parts Copyright (c) 1995 by MH Spiegel              }
  10. {                                                       }
  11. {   Parts Copyright (c) 1996 by Leon de Boer            }
  12. {   ldeboer@ibm.net                                     }
  13. {                                                       }
  14. {              THIS CODE IS FREEWARE                    }
  15. {*******************************************************}
  16.  
  17. {***************[ SUPPORTED PLATFORMS ]*****************}
  18. {  16 and 32 Bit compilers                              }
  19. {     DOS      - Turbo Pascal 7.0 +      (16 Bit)       }
  20. {              - FPK Pascal              (32 Bit)       }
  21. {     DPMI     - Turbo Pascal 7.0 +      (16 Bit)       }
  22. {     WINDOWS  - Turbo Pascal 7.0 +      (16 Bit)       }
  23. {     OS2      - Virtual Pascal 0.3 +    (32 Bit)       }
  24. {                SpeedPascal 1.5 G +     (32 Bit)       }
  25. {                C'T patch to BP         (16 Bit)       }
  26. {*******************************************************}
  27.  
  28. UNIT Objects;
  29.  
  30. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  31.                                   INTERFACE
  32. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  33.  
  34. { ******************************* REMARK ****************************** }
  35. {  FPK does not accept  $IFNDEF compiler defines and mishandles $IFDEF  }
  36. {  with constants. Can we please get this error fixed!!!!!              }
  37. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  38.  
  39. {====Compiler conditional defines to sort platforms out =============}
  40. {$DEFINE NotFPKPascal}                                { Predefine Not FPK }
  41. {$DEFINE NotOS2}                                      { Predefine NOT OS2 }
  42.  
  43. {$IFDEF FPK}                                          { FPK PASCAL }
  44.    {$DEFINE FPKPascal}                                { Set FPK definition }
  45.    {$DEFINE DOS_OS}                                   { Define DOS_OS }
  46.    {$DEFINE CODE_32_BIT}                              { 32 BIT CODE }
  47.    {$UNDEF USE_BGI}                                   { Can't use BGI }
  48.    {$UNDEF NotFPKPascal}                              { This is FPK pascal }
  49. {$ENDIF}
  50.  
  51. {$IFDEF MSDOS}                                        { MSDOS PLATFORM }
  52.    {$DEFINE DOS_OS}                                   { Define DOS_OS }
  53. {$ENDIF}
  54.  
  55. {$IFDEF DPMI}                                         { DPMI PLATFORM }
  56.    {$DEFINE DOS_OS}                                   { Define DOS_OS }
  57. {$ENDIF}
  58.  
  59. {$IFDEF Windows}                                      { WINDOWS platform }
  60.    {$DEFINE ADV_OS}                                   { Set as advanced }
  61.    {$UNDEF USE_BGI}                                   { Can't use BGI }
  62. {$ENDIF}
  63.  
  64. {$IFDEF OS2}                                          { OS2 platform }
  65.    {$DEFINE ADV_OS}                                   { Set as advanced }
  66.    {$DEFINE BPOS2}                                    { Define BPOS2 }
  67.    {$UNDEF NotOS2}                                    { This is OS2 compiler }
  68.    {$UNDEF USE_BGI}                                   { Can't use BGI }
  69. {$ENDIF}
  70.  
  71. {$IFDEF VirtualPascal}                                { VIRTUAL PASCAL }
  72.    {$DEFINE CODE_32_BIT}                              { 32 BIT CODE }
  73.    {$DEFINE ASM_32_BIT}                               { 32 BIT ASSSEMBLER }
  74.    {$DEFINE API_32_BIT}                               { 32 BIT API CALLS }
  75.    {$UNDEF BPOS2}                                     { Undefine BPOS2 }
  76. {$ENDIF}
  77.  
  78. {$IFDEF Speed}                                        { SPEED PASCAL }
  79.    {$DEFINE CODE_32_BIT}                              { 32 BIT CODE }
  80.    {$DEFINE ASM_32_BIT}                               { 32 BIT ASSSEMBLER }
  81.    {$DEFINE API_32_BIT}                               { 32 BIT API CALLS }
  82.    {$UNDEF BPOS2}                                     { Undefine BPOS2 }
  83. {$ENDIF}
  84. {--------------------------------------------------------------------}
  85.  
  86. { ******************************* REMARK ****************************** }
  87. { How about FPK accepting all the standard compiler directives even if  }
  88. { It just ignores them for now!!                                        }
  89. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  90.  
  91. {==== Compiler directives ===========================================}
  92. {$IFDEF FPKPascal}                                    { FPK PASCAL }
  93.    {$E-}
  94.    {$DEFINE NoExceptions}
  95.    {$DEFINE SString}
  96.  
  97.    CONST
  98.       Sw_MaxData = 128*1024*1024;                     { Maximum data size }
  99.  
  100.    TYPE
  101.       Sw_Word    = LongInt;                           { Long integer now }
  102.       Sw_Integer = LongInt;                           { Long integer now }
  103.  
  104.    TYPE
  105.       FuncPtr = FUNCTION (Item: Pointer; _EBP: Sw_Word): Boolean;
  106.       ProcPtr = PROCEDURE (Item: Pointer; _EBP: Sw_Word);
  107.  
  108. {$ENDIF}
  109. {$IFDEF NotFPKPascal}                                 { ALL OTHER COMPILERS }
  110.    {$N-} {  No 80x87 code generation }
  111.    {$O+} { This unit may be overlaid }
  112.    {$X+} { Extended syntax is ok }
  113.    {$F+} { Force far calls }
  114.    {$A+} { Word Align Data }
  115.    {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
  116.    {$R-} { Disable range checking }
  117.    {$S-} { Disable Stack Checking }
  118.    {$I-} { Disable IO Checking }
  119.    {$Q-} { Disable Overflow Checking }
  120.    {$V-} { Turn off strict VAR strings }
  121.    {$B-} { Allow short circuit boolean evaluations }
  122.  
  123.    {$IFNDEF CODE_32_BIT}                              { 16 BIT DEFINITIONS }
  124.    CONST
  125.       Sw_MaxData = 65520;                             { Maximum data size }
  126.  
  127.    TYPE
  128.       Sw_Word    = Word;                              { Standard word }
  129.       Sw_Integer = Integer;                           { Standard integer }
  130.    {$ELSE}                                            { 32 BIT DEFINITIONS }
  131.    CONST
  132.       Sw_MaxData = 128*1024*1024;                     { Maximum data size }
  133.  
  134.    TYPE
  135.       Sw_Word    = LongInt;                           { Long integer now }
  136.       Sw_Integer = LongInt;                           { Long integer now }
  137.    {$ENDIF}
  138.  
  139.    TYPE
  140.    {$IFDEF VirtualPascal}                             { VP is different }
  141.       FuncPtr = FUNCTION (Item: Pointer): Boolean;
  142.    {$ELSE}                                            { All others }
  143.       FuncPtr = FUNCTION (Item: Pointer; _EBP: Sw_Word): Boolean;
  144.    {$ENDIF}
  145.  
  146.    TYPE
  147.    {$IFDEF VirtualPascal}                             { VP is different }
  148.       ProcPtr = PROCEDURE (Item: Pointer);
  149.    {$ELSE}                                            { All others }
  150.       ProcPtr = PROCEDURE (Item: Pointer; _EBP: Sw_Word);
  151.    {$ENDIF}
  152.  
  153. {$ENDIF}
  154. {---------------------------------------------------------------------}
  155.  
  156. CONST
  157. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  158. {▐                         STREAM ERROR STATE MASKS                        ▌}
  159. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  160.    stOk         =  0;                                 { No stream error }
  161.    stError      = -1;                                 { Access error }
  162.    stInitError  = -2;                                 { Initialize error }
  163.    stReadError  = -3;                                 { Stream read error }
  164.    stWriteError = -4;                                 { Stream write error }
  165.    stGetError   = -5;                                 { Get object error }
  166.    stPutError   = -6;                                 { Put object error }
  167.    stSeekError  = -7;                                 { Seek error in stream }
  168.    stOpenError  = -8;                                 { Error opening stream }
  169.  
  170. CONST
  171. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  172. {▐                       STREAM ACCESS MODE CONSTANTS                      ▌}
  173. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  174.    stCreate    = $3C00;                               { Create new file }
  175.    stOpenRead  = $3D00;                               { Read access only }
  176.    stOpenWrite = $3D01;                               { Write access only }
  177.    stOpen      = $3D02;                               { Read/write access }
  178.  
  179. CONST
  180. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  181. {▐                         TCollection ERROR CODES                         ▌}
  182. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  183.    coIndexError = -1;                                 { Index out of range }
  184.    coOverflow   = -2;                                 { Overflow }
  185.  
  186. CONST
  187. { ******************************* REMARK ****************************** }
  188. {   These are completely NEW FREE VISION ONLY constants that are used   }
  189. {  in conjuction with CreateStream a NEW FREE VISION call. This call    }
  190. {  tries creating a stream in the order of the Strategy Mask and will   }
  191. {  return the successfully created stream or nil if it fails.           }
  192. { ****************************** END REMARK *** Leon de Boer, 15May96 * }
  193.  
  194. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  195. {▐                      STREAM CREATE STRATEGY MASKS                       ▌}
  196. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  197.    sa_XMSFirst   = $8000;                             { Use XMS memory 1st }
  198.    sa_EMSFirst   = $4000;                             { Use EMS memory 1st }
  199.    sa_RAMFirst   = $2000;                             { Use RAM memory 1st }
  200.    sa_DISKFirst  = $1000;                             { Use DISK space 1st }
  201.    sa_XMSSecond  = $0800;                             { Use XMS memory 2nd }
  202.    sa_EMSSecond  = $0400;                             { Use EMS memory 2nd }
  203.    sa_RAMSecond  = $0200;                             { Use RAM memory 2nd }
  204.    sa_DISKSecond = $0100;                             { Use DISK space 2nd }
  205.    sa_XMSThird   = $0080;                             { Use XMS memory 3rd }
  206.    sa_EMSThird   = $0040;                             { Use EMS memory 3rd }
  207.    sa_RAMThird   = $0020;                             { Use RAM memory 3rd }
  208.    sa_DISKThird  = $0010;                             { Use DISK space 3rd }
  209.    sa_XMSFourth  = $0008;                             { Use XMS memory 4th }
  210.    sa_EMSFourth  = $0004;                             { Use EMS memory 4th }
  211.    sa_RAMFourth  = $0002;                             { Use RAM memory 4th }
  212.    sa_DISKFourth = $0001;                             { Use DISK space 4th }
  213.  
  214. CONST
  215. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  216. {▐                          GENERAL USE CONSTANTS                          ▌}
  217. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  218. {$IFDEF VirtualPascal}
  219.    vmtHeaderSize = 12;                                { VMT header size }
  220. {$ELSE}
  221.    vmtHeaderSize = 8;                                 { VMT header size }
  222. {$ENDIF}
  223.  
  224. CONST
  225. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  226. {▐                   MAXIMUM COLLECTION SIZE CONSTANT                      ▌}
  227. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  228.    MaxCollectionSize = Sw_MaxData DIV SizeOf(Pointer);{ Max collection size }
  229.  
  230. TYPE
  231. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  232. {▐                              CHARACTER SET                              ▌}
  233. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  234.    TCharSet = SET Of Char;                            { Character set }
  235.    PCharSet = ^TCharSet;                              { Character set ptr }
  236.  
  237. TYPE
  238. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  239. {▐                              GENERAL ARRAYS                             ▌}
  240. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  241.    TByteArray = ARRAY [0..Sw_MaxData-1] Of Byte;      { Byte array }
  242.    PByteArray = ^TByteArray;                          { Byte array pointer }
  243.  
  244.    TWordArray = ARRAY [0..Sw_MaxData DIV 2-1] Of Word;{ Word array }
  245.    PWordArray = ^TWordArray;                          { Word array pointer }
  246.  
  247. TYPE
  248. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  249. {▐                           DOS FILENAME STRING                           ▌}
  250. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  251. {$IFDEF DOS_OS}                                       { DOS/DPMI DEFINE }
  252.    FNameStr = String[79];                             { DOS filename }
  253. {$ENDIF}
  254. {$IFDEF Windows}                                      { WINDOWS DEFINE }
  255.    FNameStr = PChar;                                  { Windows filename }
  256. {$ENDIF}
  257. {$IFDEF OS2}                                          { OS2 DEFINE }
  258.    FNameStr = String;                                 { OS2 filename }
  259. {$ENDIF}
  260.  
  261. TYPE
  262. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  263. {▐                           DOS ASCIIZ FILENAME                           ▌}
  264. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  265.    AsciiZ = Array [0..255] Of Char;                   { Filename array }
  266.  
  267. TYPE
  268. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  269. {▐                          GENERAL TYPE POINTERS                          ▌}
  270. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  271.    PByte    = ^Byte;                                  { Byte pointer }
  272.    PWord    = ^Word;                                  { Word pointer }
  273.    PLongInt = ^LongInt;                               { LongInt pointer }
  274.    PString  = ^String;                                { String pointer }
  275.  
  276. {***************************************************************************}
  277. {                            RECORD DEFINITIONS                             }
  278. {***************************************************************************}
  279. TYPE
  280. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  281. {▐                         TYPE CONVERSION RECORDS                         ▌}
  282. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  283.    WordRec = RECORD
  284.      Lo, Hi: Byte;                                    { Word to bytes }
  285.    END;
  286.  
  287.    LongRec = RECORD
  288.      Lo, Hi: Word;                                    { LongInt to words }
  289.    END;
  290.  
  291.    PtrRec = RECORD
  292.      Ofs, Seg: Word;                                  { Pointer to words }
  293.    END;
  294.  
  295. TYPE
  296. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  297. {▐                 TStreamRec RECORD - STREAM OBJECT RECORD                ▌}
  298. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  299.    PStreamRec = ^TStreamRec;                          { Stream record ptr }
  300.    TStreamRec = RECORD
  301.       ObjType: Sw_Word;                               { Object type id }
  302.       VmtLink: Sw_Word;                               { VMT link }
  303.       Load : Pointer;                                 { Object load code }
  304.       Store: Pointer;                                 { Object store code }
  305.       Next : Sw_Word;                                 { Bytes to next }
  306.    END;
  307.  
  308. {***************************************************************************}
  309. {                            OBJECT DEFINITIONS                             }
  310. {***************************************************************************}
  311.  
  312. TYPE
  313. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  314. {▐                       TPoint RECORD - POINT RECORD                      ▌}
  315. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  316.    TPoint = RECORD
  317.       X, Y: Integer;                                  { Point co-ordinates }
  318.    END;
  319.  
  320. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  321. {▐                     TRect OBJECT - RECTANGLE OBJECT                     ▌}
  322. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  323.    TRect = OBJECT
  324.          A, B: TPoint;                                { Corner points }
  325.       FUNCTION Empty: Boolean;
  326.       FUNCTION Equals (R: TRect): Boolean;
  327.       FUNCTION Contains (P: TPoint): Boolean;
  328.       PROCEDURE Copy (R: TRect);
  329.       PROCEDURE Union (R: TRect);
  330.       PROCEDURE Intersect (R: TRect);
  331.       PROCEDURE Move (ADX, ADY: Integer);
  332.       PROCEDURE Grow (ADX, ADY: Integer);
  333.       PROCEDURE Assign (XA, YA, XB, YB: Integer);
  334.    END;
  335.    PRect = ^TRect;
  336.  
  337. TYPE
  338. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  339. {▐                 TObject OBJECT - BASE ANCESTOR OBJECT                   ▌}
  340. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  341.    TObject = OBJECT
  342.       CONSTRUCTOR Init;
  343.       PROCEDURE Free;
  344.       DESTRUCTOR Done;                                               Virtual;
  345.    END;
  346.    PObject = ^TObject;
  347.  
  348. TYPE
  349. { ******************************* REMARK ****************************** }
  350. {  Two new virtual methods have been added to the object in the form of }
  351. {  Close and Open. The main use here is in the Disk Based Descendants   }
  352. {  the calls open and close the given file so these objects can be      }
  353. {  used like standard files. All existing code will compile and work    }
  354. {  completely normally oblivious to these new methods.                  }
  355. { ****************************** END REMARK *** Leon de Boer, 15May96 * }
  356. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  357. {▐                TStream OBJECT - STREAM ANCESTOR OBJECT                  ▌}
  358. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  359.    TStream = OBJECT (TObject)
  360.          Status   : Integer;                          { Stream status }
  361.          ErrorInfo: Integer;                          { Stream error info }
  362.       FUNCTION Get: PObject;
  363.       FUNCTION StrRead: PChar;
  364.       FUNCTION GetPos: LongInt;                                      Virtual;
  365.       FUNCTION GetSize: LongInt;                                     Virtual;
  366.       FUNCTION ReadStr: PString;
  367.       PROCEDURE Close;                                               Virtual;
  368.       PROCEDURE Reset;
  369.       PROCEDURE Flush;                                               Virtual;
  370.       PROCEDURE Truncate;                                            Virtual;
  371.       PROCEDURE Put (P: PObject);
  372.       PROCEDURE Seek (Pos: LongInt);                                 Virtual;
  373.       PROCEDURE StrWrite (P: PChar);
  374.       PROCEDURE WriteStr (P: PString);
  375.       PROCEDURE Open (OpenMode: Word);                               Virtual;
  376.       PROCEDURE Error (Code, Info: Integer);                         Virtual;
  377.       PROCEDURE Read (Var Buf; Count: Sw_Word);                      Virtual;
  378.       PROCEDURE Write (Var Buf; Count: Sw_Word);                     Virtual;
  379.       PROCEDURE CopyFrom (Var S: TStream; Count: Longint);
  380.    END;
  381.    PStream = ^TStream;
  382.  
  383. TYPE
  384. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  385. {▐               TDosStream OBJECT - DOS FILE STREAM OBJECT                ▌}
  386. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  387.    TDosStream = OBJECT (TStream)
  388.          Handle: Integer;                             { DOS file handle }
  389.          FName : AsciiZ;                              { AsciiZ filename }
  390.       CONSTRUCTOR Init (FileName: FNameStr; Mode: Word);
  391.       DESTRUCTOR Done;                                               Virtual;
  392.       FUNCTION GetPos: Longint;                                      Virtual;
  393.       FUNCTION GetSize: Longint;                                     Virtual;
  394.       PROCEDURE Close;                                               Virtual;
  395.       PROCEDURE Seek (Pos: LongInt);                                 Virtual;
  396.       PROCEDURE Open (OpenMode: Word);                               Virtual;
  397.       PROCEDURE Read (Var Buf; Count: Sw_Word);                      Virtual;
  398.       PROCEDURE Write (Var Buf; Count: Sw_Word);                     Virtual;
  399.    END;
  400.    PDosStream = ^TDosStream;
  401.  
  402. TYPE
  403. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  404. {▐               TBufStream OBJECT - BUFFERED DOS FILE STREAM              ▌}
  405. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  406.    TBufStream = OBJECT (TDosStream)
  407.    END;
  408.    PBufStream = ^TBufStream;
  409.  
  410. TYPE
  411. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  412. {▐                  TEmsStream OBJECT - EMS STREAM OBJECT                  ▌}
  413. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  414.    TEmsStream = OBJECT (TStream)
  415.    END;
  416.    PEmsStream = ^TEmsStream;
  417.  
  418. TYPE
  419. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  420. {▐                  TXmsStream OBJECT - XMS STREAM OBJECT                  ▌}
  421. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  422.    TXmsStream = OBJECT (TStream)
  423.    END;
  424.    PXmsStream = ^TXmsStream;
  425.  
  426. TYPE
  427. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  428. {▐              TMemoryStream OBJECT - MEMORY STREAM OBJECT                ▌}
  429. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  430.    TMemoryStream = OBJECT (TStream)
  431.    END;
  432.    PMemoryStream = ^TMemoryStream;
  433.  
  434. TYPE
  435.   TItemList = Array [0..MaxCollectionSize - 1] Of Pointer;
  436.   PItemList = ^TItemList;
  437.  
  438. { ******************************* REMARK ****************************** }
  439. {    The changes here look worse than they are. The Sw_Integer simply   }
  440. {  switches between Integers and LongInts if switched between 16 and 32 }
  441. {  bit code. All existing code will compile without any changes.        }
  442. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  443.  
  444. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  445. {▐             TCollection OBJECT - COLLECTION ANCESTOR OBJECT             ▌}
  446. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  447.    TCollection = OBJECT (TObject)
  448.          Items: PItemList;                            { Item list pointer }
  449.          Count: Sw_Integer;                           { Item count }
  450.          Limit: Sw_Integer;                           { Item limit count }
  451.          Delta: Sw_Integer;                           { Inc delta size }
  452.       CONSTRUCTOR Init (ALimit, ADelta: Sw_Integer);
  453.       CONSTRUCTOR Load (Var S: TStream);
  454.       DESTRUCTOR Done;                                               Virtual;
  455.       FUNCTION At (Index: Sw_Integer): Pointer;
  456.       FUNCTION IndexOf (Item: Pointer): Sw_Integer;                  Virtual;
  457.       FUNCTION GetItem (Var S: TStream): Pointer;                    Virtual;
  458.       FUNCTION LastThat (Test: Pointer): Pointer;
  459.       FUNCTION FirstThat (Test: Pointer): Pointer;
  460.       PROCEDURE Pack;
  461.       PROCEDURE FreeAll;
  462.       PROCEDURE DeleteAll;
  463.       PROCEDURE Free (Item: Pointer);
  464.       PROCEDURE Insert (Item: Pointer);                              Virtual;
  465.       PROCEDURE Delete (Item: Pointer);
  466.       PROCEDURE AtFree (Index: Sw_Integer);
  467.       PROCEDURE FreeItem (Item: Pointer);                            Virtual;
  468.       PROCEDURE AtDelete (Index: Sw_Integer);
  469.       PROCEDURE ForEach (Action: Pointer);
  470.       PROCEDURE SetLimit (ALimit: Sw_Integer);                       Virtual;
  471.       PROCEDURE Error (Code, Info: Integer);                         Virtual;
  472.       PROCEDURE AtPut (Index: Sw_Integer; Item: Pointer);
  473.       PROCEDURE AtInsert (Index: Sw_Integer; Item: Pointer);
  474.       PROCEDURE Store (Var S: TStream);
  475.       PROCEDURE PutItem (Var S: TStream; Item: Pointer);             Virtual;
  476.    END;
  477.    PCollection = ^TCollection;
  478.  
  479. TYPE
  480. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  481. {▐         TSortedCollection OBJECT - SORTED COLLECTION ANCESTOR           ▌}
  482. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  483.    TSortedCollection = OBJECT (TCollection)
  484.          Duplicates: Boolean;                         { Duplicates flag }
  485.       CONSTRUCTOR Init (ALimit, ADelta: Sw_Integer);
  486.       CONSTRUCTOR Load (Var S: TStream);
  487.       FUNCTION KeyOf (Item: Pointer): Pointer;                       Virtual;
  488.       FUNCTION IndexOf (Item: Pointer): Sw_Integer;                  Virtual;
  489.       FUNCTION Compare (Key1, Key2: Pointer): Sw_Integer;            Virtual;
  490.       FUNCTION Search (Key: Pointer; Var Index: Sw_Integer): Boolean;Virtual;
  491.       PROCEDURE Insert (Item: Pointer);                              Virtual;
  492.       PROCEDURE Store (Var S: TStream);
  493.    END;
  494.    PSortedCollection = ^TSortedCollection;
  495.  
  496. TYPE
  497. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  498. {▐          TStringCollection OBJECT - STRING COLLECTION OBJECT            ▌}
  499. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  500.    TStringCollection = OBJECT (TSortedCollection)
  501.       FUNCTION GetItem (Var S: TStream): Pointer;                    Virtual;
  502.       FUNCTION Compare (Key1, Key2: Pointer): Sw_Integer;            Virtual;
  503.       PROCEDURE FreeItem (Item: Pointer);                            Virtual;
  504.       PROCEDURE PutItem (Var S: TStream; Item: Pointer);             Virtual;
  505.    END;
  506.    PStringCollection = ^TStringCollection;
  507.  
  508. TYPE
  509. { ******************************* REMARK ****************************** }
  510. {    This is a completely NEW FREE VISION ONLY object which holds a     }
  511. {  collection of strings but does not alphabetically sort them. It is   }
  512. {  a very useful object as you will find !!!!                           }
  513. { ****************************** END REMARK *** Leon de Boer, 15May96 * }
  514. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  515. {▐        TUnSortedStrCollection - UNSORTED STRING COLLECTION OBJECT       ▌}
  516. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  517.    TUnSortedStrCollection = OBJECT (TStringCollection)
  518.       PROCEDURE Insert (Item: Pointer);                              Virtual;
  519.    END;
  520.    PUnSortedStrCollection = ^TUnSortedStrCollection;
  521.  
  522. {***************************************************************************}
  523. {                            INTERFACE ROUTINES                             }
  524. {***************************************************************************}
  525.  
  526. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  527. {▐                   DYNAMIC STRING INTERFACE ROUTINES                     ▌}
  528. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  529. FUNCTION NewStr (Const S: String): PString;
  530. PROCEDURE DisposeStr (P: PString);
  531.  
  532. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  533. {▐                       STREAM INTERFACE ROUTINES                         ▌}
  534. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  535. PROCEDURE Abstract;
  536. PROCEDURE RegisterError;
  537.  
  538. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  539. {▐                     NEW FREE VISION STREAM ROUTINES                     ▌}
  540. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  541.  
  542. { ******************************* REMARK ****************************** }
  543. {   This NEW FREE VISION call tries creating a stream in the order of   }
  544. {  the Strategy Mask and will return the successfully created stream    }
  545. {  or nil if it fails using the strategy given.                         }
  546. { ****************************** END REMARK *** Leon de Boer, 15May96 * }
  547. FUNCTION CreateStream (Strategy: Word; ReqSize: LongInt): PStream;
  548.  
  549. { ******************************* REMARK ****************************** }
  550. {   As we have to provide these NEW FREE VISION CALLS as part of our    }
  551. {  stream support we might as well provide them on the interface! They  }
  552. {  mimic the behaviour of the OS2 API calls in most cases.              }
  553. { ****************************** END REMARK *** Leon de Boer, 16May96 * }
  554.  
  555. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  556. {▐                    NEW FREE VISION DOS FILE ROUTINES                    ▌}
  557. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  558.  
  559. {=DosFileOpen=========================================================
  560. Calls the operating system to try to open the file denoted by the given
  561. AsciiZ filename in the requested file mode. Any error is held in
  562. DosStreamError and the call will return zero. If successful and no error
  563. occurs the call will return the file handle of the opened file.
  564. -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB
  565. =====================================================================}
  566. FUNCTION DosFileOpen (Var FileName: AsciiZ; Mode: Word): Word;
  567.  
  568. {$IFDEF NotOS2}                                       { DOS/DPMI/WINDOWS }
  569. {=DosRead============================================================
  570. Calls the operating system to read BufferLength bytes of data from
  571. the file denoted by the handle to the bufferarea. Any error in attempting
  572. to read from the file is held in DosStreamError and returned from call.
  573. If the return is zero (ie no error) BytesMoved contains the number of
  574. bytes read from the file.
  575. -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB
  576. =====================================================================}
  577. FUNCTION DosRead(Handle: Word; Var BufferArea; BufferLength: Sw_Word;
  578. Var BytesMoved: Sw_Word): Word;
  579.  
  580. {=DosWrite===========================================================
  581. Calls the operating system to write to BufferLength bytes of data from
  582. the bufferarea to the file denoted by the handle. Any error in attempting
  583. to write to the file is held in DosStreamError and returned from call.
  584. If the return is zero (ie no error) BytesMoved contains the number of
  585. bytes written to the file.
  586. -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB
  587. =====================================================================}
  588. FUNCTION DosWrite(Handle: Word; Var BufferArea; BufferLength: Sw_Word;
  589. Var BytesMoved: Sw_Word): Word;
  590.  
  591. {=DosSetFilePtr======================================================
  592. Calls the operating system to move the file denoted by the handle to
  593. to the requested position. The move method can be: 0 = absolute offset;
  594. 1 = offset from present location; 2 = offset from end of file;
  595. Any error is held in DosErrorStream and returned from the call.
  596. If the return is zero (ie no error) NewPos contains the new absolute
  597. file position.
  598. -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB
  599. =====================================================================}
  600. FUNCTION DosSetFilePtr (Handle: Word; Pos: LongInt; MoveType: Word;
  601. Var NewPos: LongInt): Word;
  602.  
  603. {=DosClose===========================================================
  604. Calls the operating system to close the file handle provided. Any error
  605. in attempting to close file is held DosErrorStream.
  606. -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB
  607. =====================================================================}
  608. PROCEDURE DosClose (Handle: Word);
  609. {$ENDIF}
  610.  
  611. CONST
  612. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  613. {▐                      INITIALIZED PUBLIC VARIABLES                       ▌}
  614. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  615.    StreamError: Pointer = Nil;                        { Stream error ptr }
  616. {$IFDEF NotFPKPascal}
  617.    DosStreamError: Sw_Word = $0;                      { Dos stream error }
  618. {$ENDIF}
  619.  
  620. { ******************************* REMARK ****************************** }
  621. {  FPK does not accept local variables with it's assembler which means  }
  622. {  these have to be global. Can we please get this error fixed!!!!!     }
  623. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  624. {$IFDEF FPKPascal}                                    { FPK Pascal compiler }
  625. VAR HoldEBP: Sw_Word; TransferHandle: Sw_Word;
  626.     DosStreamError: Sw_Word ;                         { Dos stream error }
  627. {$ENDIF}
  628.  
  629.  
  630. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  631.                                 IMPLEMENTATION
  632. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  633. {$IFDEF Windows}                                      { WINDOWS CODE }
  634. USES WinTypes, WinProcs;                              { Standard units }
  635. {$ENDIF}
  636.  
  637. {$IFDEF Speed}                                        { SPEED PASCAL CODE }
  638. USES BseDos;                                          { Speed Pascal def }
  639. {$ENDIF}
  640.  
  641. {$IFDEF VirtualPascal}                                { VIRTUAL PASCAL CODE }
  642. USES OS2Base;                                         { Virtual Pascal base }
  643. {$ENDIF}
  644.  
  645. {$IFDEF BPOS2}                                        { C'T PATCH TO BP CODE }
  646.  
  647.    FUNCTION DosClose (Handle: Word): Word; FAR;
  648.      EXTERNAL 'DOSCALLS' Index 59;                    { Dos close function }
  649.  
  650.    FUNCTION DosOpen (FileName: PChar; Var Handle: Word;
  651.      Var ActionTaken: Word; FileSize: LongInt;
  652.      FileAttr: Word; OpenFlag, OpenMode: Word;
  653.      Reserved: Pointer): Word; FAR;
  654.      EXTERNAL 'DOSCALLS' Index 70;                    { Dos open function }
  655.  
  656.    FUNCTION DosRead(Handle: Word; Var BufferArea;
  657.      BufferLength: Word; Var BytesRead : Word): Word; FAR;
  658.      EXTERNAL 'DOSCALLS' Index 137;                   { Dos read procedure }
  659.  
  660.    FUNCTION DosWrite(Handle: Word; Var BufferArea;
  661.      BufferLength: Word; Var BytesRead : Word): Word; FAR;
  662.      EXTERNAL 'DOSCALLS' Index 138;                   { Dos write procedure }
  663.  
  664.    FUNCTION DosSetFilePtr (Handle: Word; ulOffset: LongInt;
  665.      MoveType: Word; Var NewPointer: LongInt): LongInt; FAR;
  666.      EXTERNAL 'DOSCALLS' Index 58;                    { Dos write procedure }
  667. {$ENDIF}
  668.  
  669. {$IFDEF OS2}                                          { OS2 CODE }
  670. CONST
  671. { Private Os2 File mode magic numbers }
  672.    FmInput  = $20;                                    { Open file for input }
  673.    FmOutput = $31;                                    { Open file for output }
  674.    FmInout  = $42;                                    { Open file }
  675.    FmClosed = $0;                                     { Close file }
  676. {$ENDIF}
  677.  
  678. {$IFDEF DPMI}                                         { DPMI CODE }
  679.   {$DEFINE NewExeFormat}                              { New format EXE }
  680. {$ENDIF}
  681.  
  682. {$IFDEF ADV_OS}                                       { WINDOWS/OS2 CODE }
  683.   {$DEFINE NewExeFormat}                              { New format EXE }
  684. {$ENDIF}
  685.  
  686. CONST
  687. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  688. {▐                     INITIALIZED PRIVATE VARIABLES                       ▌}
  689. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  690.    StreamTypes: Sw_Word = $0;                         { Stream types }
  691.  
  692. {***************************************************************************}
  693. {                               OBJECT METHODS                              }
  694. {***************************************************************************}
  695.  
  696. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  697. {▐                          TRect OBJECT METHODS                           ▌}
  698. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  699.  
  700. PROCEDURE CheckEmpty (Var Rect: TRect);
  701. { ******************************* REMARK ****************************** }
  702. {  This is is my desired code but FPK does not like the with statement  }
  703. {  Can we please get this error fixed!!!!!                              }
  704. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  705. {   With Rect Do Begin }
  706. {     If (A.X >= B.X) OR (A.Y >= B.Y) Then Begin    }   { Zero of reversed }
  707. {       A.X := 0;                                   }   { Clear a.x }
  708. {       A.Y := 0;                                   }   { Clear a.y }
  709. {       B.X := 0;                                   }   { Clear b.x }
  710. {       B.Y := 0;                                   }   { Clear b.y }
  711. {     End; }
  712. {   End; }
  713. BEGIN
  714.    If (Rect.A.X >= Rect.B.X) OR
  715.    (Rect.A.Y >= Rect.B.Y) Then Begin                  { Zero of reversed }
  716.      Rect.A.X := 0;                                   { Clear a.x }
  717.      Rect.A.Y := 0;                                   { Clear a.y }
  718.      Rect.B.X := 0;                                   { Clear b.x }
  719.      Rect.B.Y := 0;                                   { Clear b.y }
  720.    End;
  721. END;
  722.  
  723. { ******************************* REMARK ****************************** }
  724. {  This is a bug fix of EMPTY from the original code which was:         }
  725. {  Empty := (A.X = B.X) AND (A.Y = B.Y)                                 }
  726. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  727.  
  728. {**TRect********************************************************************}
  729. {  Empty -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                }
  730. {***************************************************************************}
  731. FUNCTION TRect.Empty: Boolean;
  732. BEGIN
  733.    Empty := (A.X >= B.X) OR (A.Y >= B.Y);             { Empty result }
  734. END;
  735.  
  736. {**TRect********************************************************************}
  737. {  Equals -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB               }
  738. {***************************************************************************}
  739. FUNCTION TRect.Equals (R: TRect): Boolean;
  740. BEGIN
  741.    Equals := (A.X = R.A.X) AND (A.Y = R.A.Y) AND
  742.    (B.X = R.B.X) AND (B.Y = R.B.Y);                   { Equals result }
  743. END;
  744.  
  745. { ******************************* REMARK ****************************** }
  746. {  This is a bug fix of Contains from the original code which was:      }
  747. {   Contains := (P.X >= A.X) AND (P.X <= B.X) AND                       }
  748. {     (P.Y >= A.Y) AND (P.Y <= B.Y)                                     }
  749. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  750.  
  751. {**TRect********************************************************************}
  752. {  Contains -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB             }
  753. {***************************************************************************}
  754. FUNCTION TRect.Contains (P: TPoint): Boolean;
  755. BEGIN
  756.    Contains := (P.X >= A.X) AND (P.X < B.X) AND
  757.      (P.Y >= A.Y) AND (P.Y < B.Y);                    { Contains result }
  758. END;
  759.  
  760. {**TRect********************************************************************}
  761. {  Copy -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  762. {***************************************************************************}
  763. PROCEDURE TRect.Copy (R: TRect);
  764. BEGIN
  765.    A := R.A;                                          { Copy point a }
  766.    B := R.B;                                          { Copy point b }
  767. END;
  768.  
  769. {**TRect********************************************************************}
  770. {  Union -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                }
  771. {***************************************************************************}
  772. PROCEDURE TRect.Union (R: TRect);
  773. BEGIN
  774.    If (R.A.X < A.X) Then A.X := R.A.X;                { Take if smaller }
  775.    If (R.A.Y < A.Y) Then A.Y := R.A.Y;                { Take if smaller }
  776.    If (R.B.X > B.X) Then B.X := R.B.X;                { Take if larger }
  777.    If (R.B.Y > B.Y) Then B.Y := R.B.Y;                { Take if larger }
  778. END;
  779.  
  780. {**TRect********************************************************************}
  781. {  Intersect -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB            }
  782. {***************************************************************************}
  783. PROCEDURE TRect.Intersect (R: TRect);
  784. BEGIN
  785.    If (R.A.X > A.X) Then A.X := R.A.X;                { Take if larger }
  786.    If (R.A.Y > A.Y) Then A.Y := R.A.Y;                { Take if larger }
  787.    If (R.B.X < B.X) Then B.X := R.B.X;                { Take if smaller }
  788.    If (R.B.Y < B.Y) Then B.Y := R.B.Y;                { Take if smaller }
  789.    CheckEmpty(Self);                                  { Check if empty }
  790. END;
  791.  
  792. {**TRect********************************************************************}
  793. {  Move -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  794. {***************************************************************************}
  795. PROCEDURE TRect.Move (ADX, ADY: Integer);
  796. BEGIN
  797.    Inc(A.X, ADX);                                     { Adjust A.X }
  798.    Inc(A.Y, ADY);                                     { Adjust A.Y }
  799.    Inc(B.X, ADX);                                     { Adjust B.X }
  800.    Inc(B.Y, ADY);                                     { Adjust B.Y }
  801. END;
  802.  
  803. {**TRect********************************************************************}
  804. {  Grow -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  805. {***************************************************************************}
  806. PROCEDURE TRect.Grow (ADX, ADY: Integer);
  807. BEGIN
  808.    Dec(A.X, ADX);                                     { Adjust A.X }
  809.    Dec(A.Y, ADY);                                     { Adjust A.Y }
  810.    Inc(B.X, ADX);                                     { Adjust B.X }
  811.    Inc(B.Y, ADY);                                     { Adjust B.Y }
  812.    CheckEmpty(Self);                                  { Check if empty }
  813. END;
  814.  
  815. {**TRect********************************************************************}
  816. {  Assign -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB               }
  817. {***************************************************************************}
  818. PROCEDURE TRect.Assign (XA, YA, XB, YB: Integer);
  819. BEGIN
  820.    A.X := XA;                                         { Hold A.X value }
  821.    A.Y := YA;                                         { Hold A.Y value }
  822.    B.X := XB;                                         { Hold B.X value }
  823.    B.Y := YB;                                         { Hold B.Y value }
  824. END;
  825.  
  826. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  827. {▐                          TObject OBJECT METHODS                         ▌}
  828. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  829.  
  830. TYPE
  831.    DummyObject = OBJECT (TObject)                     { Internal object }
  832.      Data: RECORD END;                                { Helps size VMT link }
  833.    END;
  834.  
  835. { ******************************* REMARK ****************************** }
  836. { I Prefer this code because it self sizes VMT link rather than using a }
  837. { fixed record structure thus it should work on all compilers without a }
  838. { specific record to match each compiler.                               }
  839. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  840. CONSTRUCTOR TObject.Init;
  841. VAR LinkSize: LongInt; Dummy: DummyObject;
  842. BEGIN
  843.    LinkSize := LongInt(@Dummy.Data)-LongInt(@Dummy);  { Calc VMT link size }
  844.    FillChar(Pointer(LongInt(@Self)+LinkSize)^,
  845.      SizeOf(Self)-LinkSize, #0);                      { Clear data fields }
  846. END;
  847.  
  848. {**TObject******************************************************************}
  849. {  Free -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  850. {***************************************************************************}
  851. PROCEDURE TObject.Free;
  852. BEGIN
  853.    Dispose(PObject(@Self), Done);                     { Dispose of self }
  854. END;
  855.  
  856. {**TObject******************************************************************}
  857. {  Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  858. {***************************************************************************}
  859. DESTRUCTOR TObject.Done;
  860. BEGIN                                                 { Abstract method }
  861. END;
  862.  
  863. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  864. {▐                          TStream OBJECT METHODS                         ▌}
  865. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  866.  
  867. { ******************************* REMARK ****************************** }
  868. {  Bug fix of TStream.StrRead from the original code which was:         }
  869. {  GetMem(P, L+1) can fail and return Nil which should be checked!      }
  870. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  871.  
  872. {**TStream******************************************************************}
  873. {  StrRead -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB              }
  874. {***************************************************************************}
  875. FUNCTION TStream.StrRead: PChar;
  876. VAR L: Word; P: PChar;
  877. BEGIN
  878.    Read(L, SizeOf(L));                                { Read length }
  879.    If (L=0) Then StrRead := Nil Else Begin            { Check for empty }
  880.      GetMem(P, L + 1);                                { Allocate memory }
  881.      If (P<>Nil) Then Begin                           { Check allocate okay }
  882.        Read(P[0], L);                                 { Read the data }
  883.        P[L] := #0;                                    { Terminate with #0 }
  884.      End;
  885.      StrRead := P;                                    { Return PChar }
  886.    End;
  887. END;
  888.  
  889. { ******************************* REMARK ****************************** }
  890. {  Bug fix of TStream.ReadStr from the original code which was:         }
  891. {  GetMem(P, L+1) can fail and return Nil which should be checked!      }
  892. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  893.  
  894. {**TStream******************************************************************}
  895. {  ReadStr -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB              }
  896. {***************************************************************************}
  897. FUNCTION TStream.ReadStr: PString;
  898. VAR L: Byte; P: PString;
  899. BEGIN
  900.    Read(L, 1);                                        { Read string length }
  901.    If (L > 0) Then Begin
  902.      GetMem(P, L + 1);                                { Allocate memory }
  903.      If (P<>Nil) Then Begin                           { Check allocate okay }
  904.        P^[0] := Char(L);                              { Hold length }
  905.        Read(P^[1], L);                                { Read string data }
  906.      End;
  907.      ReadStr := P;                                    { Return string ptr }
  908.    End Else ReadStr := Nil;
  909. END;
  910.  
  911. {**TStream******************************************************************}
  912. {  GetPos -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB               }
  913. {***************************************************************************}
  914. FUNCTION TStream.GetPos: LongInt;
  915. BEGIN                                                 { Abstract method }
  916.    Abstract;                                          { Abstract error }
  917. END;
  918.  
  919. {**TStream******************************************************************}
  920. {  GetSize -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB              }
  921. {***************************************************************************}
  922. FUNCTION TStream.GetSize: LongInt;
  923. BEGIN                                                 { Abstract method }
  924.    Abstract;                                          { Abstract error }
  925. END;
  926.  
  927. {**TStream******************************************************************}
  928. {  Close -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                }
  929. {***************************************************************************}
  930. PROCEDURE TStream.Close;
  931. BEGIN                                                 { Abstract method }
  932. END;
  933.  
  934. {**TStream******************************************************************}
  935. {  Reset -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                }
  936. {***************************************************************************}
  937. PROCEDURE TStream.Reset;
  938. BEGIN
  939.    Status := 0;                                       { Clear status }
  940.    ErrorInfo := 0;                                    { Clear error info }
  941. END;
  942.  
  943. {**TStream******************************************************************}
  944. {  Flush -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                }
  945. {***************************************************************************}
  946. PROCEDURE TStream.Flush;
  947. BEGIN                                                 { Abstract method }
  948. END;
  949.  
  950. {**TStream******************************************************************}
  951. {  Truncate -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB             }
  952. {***************************************************************************}
  953. PROCEDURE TStream.Truncate;
  954. BEGIN
  955.    Abstract;                                          { Abstract error }
  956. END;
  957.  
  958. {**TStream******************************************************************}
  959. {  Seek -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  960. {***************************************************************************}
  961. PROCEDURE TStream.Seek (Pos: LongInt);
  962. BEGIN
  963.    Abstract;                                          { Abstract error }
  964. END;
  965.  
  966. {**TStream******************************************************************}
  967. {  StrWrite -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB             }
  968. {***************************************************************************}
  969. PROCEDURE TStream.StrWrite (P: PChar);
  970. VAR L: Word; Q: PByteArray;
  971. BEGIN
  972.    L := 0;                                            { Preset no size }
  973.    Q := PByteArray(P);                                { Transfer type }
  974.    If (Q<>Nil) Then While (Q^[L]<>0) Do Inc(L);       { Calc PChar length }
  975.    Write(L, SizeOf(L));                               { Store PChar length }
  976.    If (P<>Nil) Then Write(P[0], L);                   { Write data }
  977. END;
  978.  
  979. {**TStream******************************************************************}
  980. {  WriteStr -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB             }
  981. {***************************************************************************}
  982. PROCEDURE TStream.WriteStr (P: PString);
  983. CONST Empty: String[1] = '';
  984. BEGIN
  985.    If (P<>Nil) Then Write(P^, Length(P^) + 1)         { Write string }
  986.      Else Write(Empty, 1);                            { Write empty string }
  987. END;
  988.  
  989. {**TStream******************************************************************}
  990. {  Open -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  991. {***************************************************************************}
  992. PROCEDURE TStream.Open (OpenMode: Word);
  993. BEGIN                                                 { Abstract method }
  994. END;
  995.  
  996. {**TStream******************************************************************}
  997. {  Error -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                }
  998. {***************************************************************************}
  999. PROCEDURE TStream.Error (Code, Info: Integer);
  1000. TYPE TErrorProc = Procedure(Var S: TStream);
  1001. BEGIN
  1002.    Status := Code;                                    { Hold error code }
  1003.    ErrorInfo := Info;                                 { Hold error info }
  1004.    If (StreamError<>Nil) Then
  1005.      TErrorProc(StreamError)(Self);                   { Call error ptr }
  1006. END;
  1007.  
  1008. {**TStream******************************************************************}
  1009. {  Read -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                 }
  1010. {***************************************************************************}
  1011. PROCEDURE TStream.Read (Var Buf; Count: Sw_Word);
  1012. BEGIN
  1013.    Abstract;                                          { Abstract error }
  1014. END;
  1015.  
  1016. {**TStream******************************************************************}
  1017. {  Write -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB                }
  1018. {***************************************************************************}
  1019. PROCEDURE TStream.Write (Var Buf; Count: Sw_Word);
  1020. BEGIN
  1021.    Abstract;                                          { Abstract error }
  1022. END;
  1023.  
  1024. {**TStream******************************************************************}
  1025. {  CopyFrom -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB             }
  1026. {***************************************************************************}
  1027. PROCEDURE TStream.CopyFrom (Var S: TStream; Count: Longint);
  1028. VAR W: Word; Buffer: Array[0..1023] of Byte;
  1029. BEGIN
  1030.    While (Count > 0) Do Begin
  1031.      If (Count > SizeOf(Buffer)) Then                 { To much data }
  1032.        W := SizeOf(Buffer) Else W := Count;           { Size to transfer }
  1033.      S.Read(Buffer, W);                               { Read from stream }
  1034.      Write(Buffer, W);                                { Write to stream }
  1035.      Dec(Count, W);                                   { Dec write count }
  1036.    End;
  1037. END;
  1038.  
  1039. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  1040. {▐                        TDosStream OBJECT METHODS                        ▌}
  1041. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  1042.  
  1043. {**TDosStream***************************************************************}
  1044. {  Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB                 }
  1045. {***************************************************************************}
  1046. CONSTRUCTOR TDosStream.Init (FileName: FNameStr; Mode: Word);
  1047. BEGIN
  1048.    Inherited Init;                                    { Call ancestor }
  1049.    {$IFDEF Windows}
  1050.    AnsiToOem(FileName, FName);                        { Ansi to OEM }
  1051.    {$ELSE}
  1052.    FileName := FileName+#0;                           { Make asciiz }
  1053.    Move(FileName[1], FName, Length(FileName));        { Create asciiz name }
  1054.    {$ENDIF}
  1055.    Handle := DosFileOpen(FName, Mode);                { Open the file }
  1056.    If (Handle=0) Then Begin                           { Open failed }
  1057.      Error(stInitError, DosStreamError);              { Call error }
  1058.      Status := stInitError;                           { Set fail status }
  1059.      Handle := -1;                                    { Set invalid handle }
  1060.    End;
  1061. END;
  1062.  
  1063. {**TDosStream***************************************************************}
  1064. {  Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB                 }
  1065. {***************************************************************************}
  1066. DESTRUCTOR TDosStream.Done;
  1067. BEGIN
  1068.    If (Handle <> -1) Then DosClose(Handle);           { Close the file }
  1069.    Inherited Done;                                    { Call ancestor }
  1070. END;
  1071.  
  1072. {**TDosStream***************************************************************}
  1073. {  GetPos -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB               }
  1074. {***************************************************************************}
  1075. FUNCTION TDosStream.GetPos: LongInt;
  1076. VAR NewPosition: LongInt;
  1077. BEGIN
  1078.    If (Status=stOk) Then Begin                        { Check status okay }
  1079.      If (Handle = -1) Then DosStreamError := 103      { File not open }
  1080.        Else DosStreamError := DosSetFilePtr(Handle,
  1081.         0, 1, NewPosition);                           { Get file position }
  1082.      If (DosStreamError<>0) Then Begin                { Check for error }
  1083.         Error(stError, DosStreamError);               { Identify error }
  1084.         NewPosition := -1;                            { Invalidate position }
  1085.      End;
  1086.      GetPos := NewPosition;                           { Return file position }
  1087.    End Else GetPos := -1;                             { Stream in error }
  1088. END;
  1089.  
  1090. {**TDosStream***************************************************************}
  1091. {  GetSize -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB              }
  1092. {***************************************************************************}
  1093. FUNCTION TDosStream.GetSize: LongInt;
  1094. VAR CurrentPos, FileEndPos: LongInt;
  1095. BEGIN
  1096.    If (Status=stOk) Then Begin                        { Check status okay }
  1097.      If (Handle = -1) Then DosStreamError := 103      { File not open }
  1098.        Else DosStreamError := DosSetFilePtr(Handle,
  1099.         0, 1, CurrentPos);                            { Current position }
  1100.      If (DosStreamError=0) Then Begin                 { Check no errors }
  1101.         DosStreamError := DosSetFilePtr(Handle, 0, 2,
  1102.           FileEndPos);                                { Locate end of file }
  1103.         If (DosStreamError=0) Then
  1104.           DosSetFilePtr(Handle, 0, 1, CurrentPos);    { Reset position }
  1105.      End;
  1106.      If (DosStreamError<>0) Then Begin                { Check for error }
  1107.         Error(stError, DosStreamError);               { Identify error }
  1108.         FileEndPos := -1;                             { Invalidate size }
  1109.      End;
  1110.      GetSize := FileEndPos;                           { Return file size }
  1111.    End Else GetSize := -1;                            { Stream in error }
  1112. END;
  1113.  
  1114. {**TDosStream***************************************************************}
  1115. {  Close -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB                }
  1116. {***************************************************************************}
  1117. PROCEDURE TDosStream.Close;
  1118. BEGIN
  1119.    If (Handle <> -1) Then DosClose(Handle);           { Close the file }
  1120.    Handle := -1;                                      { Handle now invalid }
  1121. END;
  1122.  
  1123. {**TDosStream***************************************************************}
  1124. {  Seek -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB                 }
  1125. {***************************************************************************}
  1126. PROCEDURE TDosStream.Seek (Pos: LongInt);
  1127. VAR NewPosition: LongInt;
  1128. BEGIN
  1129.    If (Status=stOk) Then Begin                        { Check status okay }
  1130.      If (Pos < 0) Then Pos := 0;                      { Negatives removed }
  1131.      If (Handle = -1) Then DosStreamError := 103      { File not open }
  1132.        Else DosStreamError := DosSetFilePtr(Handle,
  1133.          Pos, 0, NewPosition);                        { Set file position }
  1134.      If ((DosStreamError<>0) OR (NewPosition<>Pos))   { We have an error }
  1135.      Then Begin
  1136.        If (DosStreamError<>0) Then                    { Error was detected }
  1137.          Error(stError, DosStreamError)               { Specific seek error }
  1138.          Else Error(stSeekError, 0);                  { General seek error }
  1139.      End;
  1140.    End;
  1141. END;
  1142.  
  1143. {**TDosStream***************************************************************}
  1144. {  Open -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB                 }
  1145. {***************************************************************************}
  1146. PROCEDURE TDosStream.Open (OpenMode: Word);
  1147. BEGIN
  1148.    If (Handle = -1) Then Begin                        { File not open }
  1149.      Handle := DosFileOpen(FName, OpenMode);          { Open the file }
  1150.      If (Handle=0) Then Begin                         { File open failed }
  1151.        Error(stOpenError, DosStreamError);            { Call error }
  1152.        Handle := -1;                                  { Set invalid handle }
  1153.      End;
  1154.    End;
  1155. END;
  1156.  
  1157. {**TDosStream***************************************************************}
  1158. {  Read -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB                 }
  1159. {***************************************************************************}
  1160. PROCEDURE TDosStream.Read (Var Buf; Count: Sw_Word);
  1161. VAR BytesMoved: Sw_Word;
  1162. BEGIN
  1163.    If (Status=stOk) Then Begin                        { Check status }
  1164.      If (Handle = -1) Then BytesMoved := 0 Else       { File not open }
  1165.        DosStreamError := DosRead(Handle, Buf, Count,
  1166.          BytesMoved);                                 { Read from file }
  1167.      If ((DosStreamError<>0) OR (BytesMoved<>Count))  { We have an error }
  1168.      Then Begin
  1169.        If (DosStreamError<>0) Then                    { Error was detected }
  1170.          Error(stError, DosStreamError)               { Specific read error }
  1171.          Else Error(stReadError, 0);                  { General read error }
  1172.      End;
  1173.    End Else FillChar(Buf, Count, #0);                 { Error clear buffer }
  1174. END;
  1175.  
  1176. {**TDosStream***************************************************************}
  1177. {  Write -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB                }
  1178. {***************************************************************************}
  1179. PROCEDURE TDosStream.Write (Var Buf; Count: Sw_Word);
  1180. VAR BytesMoved: Sw_Word;
  1181. BEGIN
  1182.    If (Status=stOk) Then Begin
  1183.      If (Handle=-1) Then BytesMoved := 0 Else         { File not open }
  1184.        DosStreamError := DosWrite(Handle, Buf, Count,
  1185.          BytesMoved);                                 { Write to file }
  1186.      If ((DosStreamError<>0) OR (BytesMoved<>Count))  { We have an error }
  1187.      Then Begin
  1188.        If (DosStreamError<>0) Then                    { Error was detected }
  1189.          Error(stError, DosStreamError)               { Specific write error }
  1190.          Else Error(stWriteError, 0);                 { General write error }
  1191.      End;
  1192.    End;
  1193. END;
  1194.  
  1195. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  1196. {▐                      TCollection OBJECT METHODS                         ▌}
  1197. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  1198.  
  1199. CONSTRUCTOR TCollection.Init (ALimit, ADelta: Sw_Integer);
  1200. BEGIN
  1201.    Inherited Init;                                    { Call ancestor }
  1202.    Delta := ADelta;                                   { Set increment }
  1203.    SetLimit(ALimit);                                  { Set limit }
  1204. END;
  1205.  
  1206. CONSTRUCTOR TCollection.Load (Var S: TStream);
  1207. VAR C, I: Sw_Integer;
  1208. BEGIN
  1209.    S.Read(Count, SizeOf(Count));                      { Read count }
  1210.    S.Read(Limit, SizeOf(Limit));                      { Read limit }
  1211.    S.Read(Delta, SizeOf(Delta));                      { Read delta }
  1212.    Items := Nil;                                      { Clear item pointer }
  1213.    C := Count;                                        { Hold count }
  1214.    I := Limit;                                        { Hold limit }
  1215.    Count := 0;                                        { Clear count }
  1216.    Limit := 0;                                        { Clear limit }
  1217.    SetLimit(I);                                       { Set requested limit }
  1218.    Count := C;                                        { Set count }
  1219.    For I := 0 To C-1 Do AtPut(I, GetItem(S));         { Get each item }
  1220. END;
  1221.  
  1222. DESTRUCTOR TCollection.Done;
  1223. BEGIN
  1224.    FreeAll;                                           { Free all items }
  1225.    SetLimit(0);                                       { Release all memory }
  1226. END;
  1227.  
  1228. FUNCTION TCollection.At (Index: Sw_Integer): Pointer;
  1229. BEGIN
  1230.    If (Index < 0) OR (Index >= Count) Then Begin      { Invalid index }
  1231.      Error(coIndexError, Index);                      { Call error }
  1232.      At := Nil;                                       { Return nil }
  1233.    End Else At := Items^[Index];                      { Return item }
  1234. END;
  1235.  
  1236. { ******************************* REMARK ****************************** }
  1237. {  Bug fix of TCollection.IndexOf from the original code which was:     }
  1238. {  For I := 0 To Count-1 Do  <- What happens if count=0!!!!             }
  1239. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  1240. FUNCTION TCollection.IndexOf (Item: Pointer): Sw_Integer;
  1241. VAR I: Sw_Integer;
  1242. BEGIN
  1243.    If (Count>0) Then Begin                            { Count is positive }
  1244.      For I := 0 To Count-1 Do                         { For each item }
  1245.        If (Items^[I]=Item) Then Begin                 { Look for match }
  1246.          IndexOf := I;                                { Return index }
  1247.          Exit;                                        { Now exit }
  1248.        End;
  1249.    End;
  1250.    IndexOf := -1;                                     { Return index }
  1251. END;
  1252.  
  1253. FUNCTION TCollection.GetItem (Var S: TStream): Pointer;
  1254. BEGIN
  1255.    GetItem := S.Get;                                  { Item off stream }
  1256. END;
  1257.  
  1258. FUNCTION TCollection.LastThat (Test: Pointer): Pointer;
  1259. VAR I: LongInt; P: FuncPtr; {$IFDEF NotFPKPascal} Hold_EBP: Sw_Word; {$ENDIF}
  1260. BEGIN
  1261.    {$IFDEF FPKPascal}                                 { FPK pascal compiler }
  1262.    ASM
  1263.      MOVL (%EBP), %EAX;                               { Load EBP }
  1264.      MOVL %EAX, U_OBJECTS_HOLDEBP;                    { Store to global }
  1265.    END;
  1266.    {$ELSE}                                            { Other compilers }
  1267.    ASM
  1268.      {$IFNDEF CODE_32_BIT}                            { 16 BIT CODE }
  1269.        MOV AX, [BP];                                  { Load AX from BP }
  1270.        {$IFDEF Windows}
  1271.        AND AL, 0FEH;                                  { Windows make even }
  1272.        {$ENDIF}
  1273.        MOV Hold_EBP, AX;                              { Hold value }
  1274.      {$ELSE}                                          { 32 BIT CODE }
  1275.        MOV EAX, [EBP];                                { Load EAX from EBP }
  1276.        MOV Hold_EBP, EAX;                             { Hold value }
  1277.      {$ENDIF}
  1278.    END;
  1279.    {$ENDIF}
  1280.    P := FuncPtr(Test);                                { Set function ptr }
  1281.    For I := Count DownTo 1 Do Begin                   { Down from last item }
  1282.      {$IFDEF FPKPascal}
  1283.        {$$$$$ crahes the compiler
  1284.        If P(Items^[I-1], HoldEBP) Then
  1285.        } Begin          { Test each item }
  1286.      {$ELSE}
  1287.        {$IFDEF VirtualPascal}
  1288.          If P(Items^[I-1]) Then Begin                 { Test each item }
  1289.        {$ELSE}
  1290.          If P(Items^[I-1], Hold_EBP) Then Begin       { Test each item }
  1291.        {$ENDIF}
  1292.      {$ENDIF}
  1293.        LastThat := Items^[I-1];                       { Return item }
  1294.        Exit;                                          { Now exit }
  1295.      End;
  1296.    End;
  1297.    LastThat := Nil;                                   { None passed test }
  1298. END;
  1299.  
  1300. FUNCTION TCollection.FirstThat (Test: Pointer): Pointer;
  1301. VAR I: LongInt; P: FuncPtr; {$IFDEF NotFPKPascal} Hold_EBP: Sw_Word; {$ENDIF}
  1302. BEGIN
  1303.    {$IFDEF FPKPascal}                                 { FPK pascal compiler }
  1304.    ASM
  1305.      MOVL (%EBP), %EAX;                               { Load EBP }
  1306.      MOVL %EAX, U_OBJECTS_HOLDEBP;                    { Store to global }
  1307.    END;
  1308.    {$ELSE}                                            { Other compilers }
  1309.    ASM
  1310.      {$IFNDEF CODE_32_BIT}                            { 16 BIT CODE }
  1311.        MOV AX, [BP];                                  { Load AX from BP }
  1312.        {$IFDEF Windows}
  1313.        AND AL, 0FEH;                                  { Windows make even }
  1314.        {$ENDIF}
  1315.        MOV Hold_EBP, AX;                              { Hold value }
  1316.      {$ELSE}                                          { 32 BIT CODE }
  1317.        MOV EAX, [EBP];                                { Load EAX from EBP }
  1318.        MOV Hold_EBP, EAX;                             { Hold value }
  1319.      {$ENDIF}
  1320.    END;
  1321.    {$ENDIF}
  1322.    P := FuncPtr(Test);                                { Set function ptr }
  1323.    For I := 1 To Count Do Begin                       { Up from first item }
  1324.      {$IFDEF FPKPascal}
  1325.        {$$$$$$ crashes the compiler
  1326.        If P(Items^[I-1], HoldEBP) Then }
  1327.        Begin          { Test each item }
  1328.      {$ELSE}
  1329.        {$IFDEF VirtualPascal}
  1330.          If P(Items^[I-1]) Then Begin                 { Test each item }
  1331.        {$ELSE}
  1332.          If P(Items^[I-1], Hold_EBP) Then Begin       { Test each item }
  1333.        {$ENDIF}
  1334.      {$ENDIF}
  1335.        FirstThat := Items^[I-1];                      { Return item }
  1336.        Exit;                                          { Now exit }
  1337.      End;
  1338.    End;
  1339.    FirstThat := Nil;                                  { None passed test }
  1340. END;
  1341.  
  1342. { ******************************* REMARK ****************************** }
  1343. {  Bug fix of TCollection.Pack from the original code which was:        }
  1344. {  While (I<Count) Do  -  Yes but who forget to initialize variable I   }
  1345. {  If count is equal to zero this was going to crash big time and you   }
  1346. {  must re-adjust the count value - Basically it was stuffed!!!         }
  1347. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  1348. PROCEDURE TCollection.Pack;
  1349. VAR I, J: Sw_Integer;
  1350. BEGIN
  1351.    If (Count>0) Then Begin                            { Count is positive }
  1352.      I := 0;                                          { Initialize dest }
  1353.      For J := 1 To Count Do Begin                     { For each item }
  1354.        If (Items^[J]<>Nil) Then Begin                 { Entry is non nil }
  1355.          Items^[I] := Items^[J];                      { Transfer item }
  1356.          Inc(I);                                      { Advance dest }
  1357.        End;
  1358.      End;
  1359.      Count := I;                                      { Adjust count }
  1360.    End;
  1361. END;
  1362.  
  1363. PROCEDURE TCollection.FreeAll;
  1364. VAR I: Sw_Integer;
  1365. BEGIN
  1366.    For I := 0 To Count-1 Do FreeItem(At(I));          { Release each item }
  1367.    Count := 0;                                        { Clear item count }
  1368. END;
  1369.  
  1370. PROCEDURE TCollection.DeleteAll;
  1371. BEGIN
  1372.    Count := 0;                                        { Clear item count }
  1373. END;
  1374.  
  1375. PROCEDURE TCollection.Free (Item: Pointer);
  1376. BEGIN
  1377.    Delete(Item);                                      { Delete from list }
  1378.    FreeItem(Item);                                    { Free the item }
  1379. END;
  1380.  
  1381. PROCEDURE TCollection.Insert (Item: Pointer);
  1382. BEGIN
  1383.    AtInsert(Count, Item);                             { Insert item }
  1384. END;
  1385.  
  1386. PROCEDURE TCollection.Delete (Item: Pointer);
  1387. BEGIN
  1388.    AtDelete(IndexOf(Item));                           { Delete from list }
  1389. END;
  1390.  
  1391. PROCEDURE TCollection.AtFree (Index: Sw_Integer);
  1392. VAR Item: Pointer;
  1393. BEGIN
  1394.    Item := At(Index);                                 { Retreive item ptr }
  1395.    AtDelete(Index);                                   { Delete item }
  1396.    FreeItem(Item);                                    { Free the item }
  1397. END;
  1398.  
  1399. PROCEDURE TCollection.FreeItem (Item: Pointer);
  1400. VAR P: PObject;
  1401. BEGIN
  1402.    P := PObject(Item);                                { Convert pointer }
  1403.    If (P<>Nil) Then Dispose(P, Done);                 { Dispose of object }
  1404. END;
  1405.  
  1406. PROCEDURE TCollection.AtDelete (Index: Sw_Integer);
  1407. BEGIN
  1408.    If (Index >= 0) AND (Index < Count) Then Begin     { Valid index }
  1409.      Dec(Count);                                      { One less item }
  1410.      If (Count>Index) Then Move(Items^[Index+1],
  1411.       Items^[Index], (Count-Index)*Sizeof(Pointer));  { Shuffle items down }
  1412.    End Else Error(coIndexError, Index);               { Index error }
  1413. END;
  1414.  
  1415. PROCEDURE TCollection.ForEach (Action: Pointer);
  1416. VAR I: LongInt; P: ProcPtr; {$IFDEF NotFPKPascal} Hold_EBP: Sw_Word; {$ENDIF}
  1417. BEGIN
  1418.    {$IFDEF FPKPascal}                                 { FPK pascal compiler }
  1419.    ASM
  1420.      MOVL (%EBP), %EAX;                               { Load EBP }
  1421.      MOVL %EAX, U_OBJECTS_HOLDEBP;                    { Store to global }
  1422.    END;
  1423.    {$ELSE}                                            { Other compilers }
  1424.    ASM
  1425.      {$IFNDEF CODE_32_BIT}                            { 16 BIT CODE }
  1426.        MOV AX, [BP];
  1427.        {$IFDEF WINDOWS}
  1428.        AND AL, 0FEH;                                  { Windows make even }
  1429.        {$ENDIF}
  1430.        MOV Hold_EBP, AX;                              { Hold value }
  1431.      {$ELSE}                                          { 32 BIT CODE }
  1432.        MOV EAX, [EBP];                                { Load EAX from EBP }
  1433.        MOV Hold_EBP, EAX;                             { Hold value }
  1434.      {$ENDIF}
  1435.    END;
  1436.    {$ENDIF}
  1437.    P := ProcPtr(Action);                              { Set procedure ptr }
  1438.    For I := 1 To Count Do                             { Up from first item }
  1439.      {$IFDEF FPKPascal}
  1440.        P(Items^[I-1], HoldEBP);                       { Call with each item }
  1441.      {$ELSE}
  1442.        {$IFDEF VirtualPascal}
  1443.          P(Items^[I-1]);                              { Call with each item }
  1444.        {$ELSE}
  1445.          P(Items^[I-1], Hold_EBP);                    { Call with each item }
  1446.        {$ENDIF}
  1447.     {$ENDIF}
  1448. END;
  1449.  
  1450. { ******************************* REMARK ****************************** }
  1451. {  Bug fix of TCollection.SetLimit from the original code which was:    }
  1452. {  getmem(p,alimit*sizeof(pointer));  <- This can fail OR ALimit=0      }
  1453. {  move(items^,p^,count*sizeof(Pointer)); <- This would now crash!      }
  1454. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  1455. PROCEDURE TCollection.SetLimit (ALimit: Sw_Integer);
  1456. VAR AItems: PItemList;
  1457. BEGIN
  1458.    If (ALimit < Count) Then ALimit := Count;          { Stop underflow }
  1459.    If (ALimit > MaxCollectionSize) Then
  1460.      ALimit := MaxCollectionSize;                     { Stop overflow }
  1461.    If (ALimit <> Limit) Then Begin                    { Limits differ }
  1462.      If (ALimit = 0) Then AItems := Nil Else          { Alimit=0 nil entry }
  1463.        GetMem(AItems, ALimit * SizeOf(Pointer));      { Allocate memory }
  1464.      If (AItems<>Nil) OR (ALimit=0) Then Begin        { Check success }
  1465.        If (AItems <>Nil) AND (Items <> Nil) Then      { Check both valid }
  1466.          Move(Items^, AItems^, Count*SizeOf(Pointer));{ Move existing items }
  1467.        If (Limit <> 0) AND (Items <> Nil) Then        { Check old allocation }
  1468.          FreeMem(Items, Limit * SizeOf(Pointer));     { Release memory }
  1469.        Items := AItems;                               { Update items }
  1470.        Limit := ALimit;                               { Set limits }
  1471.      End;
  1472.    End;
  1473. END;
  1474.  
  1475. PROCEDURE TCollection.Error (Code, Info: Integer);
  1476. BEGIN
  1477.    RunError(212 - Code);                              { Run error }
  1478. END;
  1479.  
  1480. PROCEDURE TCollection.AtPut (Index: Sw_Integer; Item: Pointer);
  1481. BEGIN
  1482.    If (Index >= 0) AND (Index < Count) Then           { Index valid }
  1483.      Items^[Index] := Item                            { Put item in index }
  1484.      Else Error(coIndexError, Index);                 { Index error }
  1485. END;
  1486.  
  1487. { ******************************* REMARK ****************************** }
  1488. {  Bug fix of TCollection.AtInsert from the original code which was:    }
  1489. {  original remark: copy old items, count is tested by move             }
  1490. {  Move(Items^[Index], Items^[Index+1],(Count-Index)*Sizeof(Pointer));  }
  1491. {  This does not work you must work from the back down!!!!              }
  1492. { ****************************** END REMARK *** Leon de Boer, 10May96 * }
  1493. PROCEDURE TCollection.AtInsert (Index: Sw_Integer; Item: Pointer);
  1494. VAR I: Sw_Integer;
  1495. BEGIN
  1496.    If (Index >= 0) AND (Index <= Count) Then Begin    { Valid index }
  1497.      If (Count=Limit) Then  SetLimit(Limit+Delta);    { Expand size if able }
  1498.      If (Limit>Count) Then Begin
  1499.        If (Index < Count) Then Begin                  { Not last item }
  1500.          For I := Count DownTo Index Do               { Start from back }
  1501.            Items^[I] := Items^[I-1];                  { Move each item }
  1502.        End;
  1503.        Items^[Index] := Item;                         { Put item in list }
  1504.        Inc(Count);                                    { Inc count }
  1505.      End Else Error(coOverflow, Index);               { Expand failed }
  1506.    End Else Error(coIndexError, Index);               { Index error }
  1507. END;
  1508.  
  1509. PROCEDURE TCollection.Store (Var S: TStream);
  1510.  
  1511.    PROCEDURE DoPutItem (P: Pointer); FAR;
  1512.    BEGIN
  1513.      PutItem(S, P);                                   { Put item on stream }
  1514.    END;
  1515.  
  1516. BEGIN
  1517.    S.Write(Count, SizeOf(Count));                     { Write count }
  1518.    S.Write(Limit, SizeOf(Limit));                     { Write limit }
  1519.    S.Write(Delta, SizeOf(Delta));                     { Write delta }
  1520.    ForEach(@DoPutItem);                               { Each item to stream }
  1521. END;
  1522.  
  1523. PROCEDURE TCollection.PutItem (Var S: TStream; Item: Pointer);
  1524. BEGIN
  1525.    S.Put(Item);                                       { Put item on stream }
  1526. END;
  1527.  
  1528. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  1529. {▐                      TSortedCollection OBJECT METHODS                   ▌}
  1530. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  1531.  
  1532. CONSTRUCTOR TSortedCollection.Init (ALimit, ADelta: Sw_Integer);
  1533. BEGIN
  1534.    Inherited Init(ALimit, ADelta);                    { Call ancestor }
  1535.    Duplicates := False;                               { Clear flag }
  1536. END;
  1537.  
  1538. CONSTRUCTOR TSortedCollection.Load (Var S: TStream);
  1539. BEGIN
  1540.    Inherited Load(S);                                 { Call ancestor }
  1541.    S.Read(Duplicates, SizeOf(Duplicates));            { Read duplicate flag }
  1542. END;
  1543.  
  1544. FUNCTION TSortedCollection.KeyOf (Item: Pointer): Pointer;
  1545. BEGIN
  1546.    KeyOf := Item;                                     { Return item }
  1547. END;
  1548.  
  1549. FUNCTION TSortedCollection.IndexOf (Item: Pointer): Sw_Integer;
  1550. VAR I: Sw_Integer;
  1551. BEGIN
  1552.    IndexOf := -1;                                     { Preset result }
  1553.    If Search(KeyOf(Item), I) Then Begin               { Search for item }
  1554.      If Duplicates Then                               { Duplicates allowed }
  1555.        While (I < Count) AND (Item <> Items^[I]) Do
  1556.          Inc(I);                                      { Count duplicates }
  1557.      If (I < Count) Then IndexOf := I;                { Return result }
  1558.    End;
  1559. END;
  1560.  
  1561. FUNCTION TSortedCollection.Compare (Key1, Key2: Pointer): Sw_Integer;
  1562. BEGIN
  1563.    Abstract;                                          { Abstract method }
  1564. END;
  1565.  
  1566. FUNCTION TSortedCollection.Search (Key: Pointer; Var Index: Sw_Integer): Boolean;
  1567. VAR L, H, I, C: Sw_Integer;
  1568. BEGIN
  1569.    Search := False;                                   { Preset failure }
  1570.    L := 0;                                            { Start count }
  1571.    H := Count - 1;                                    { End count }
  1572.    While (L <= H) Do Begin
  1573.      I := (L + H) SHR 1;                              { Mid point }
  1574.      C := Compare(KeyOf(Items^[I]), Key);             { Compare with key }
  1575.      If (C < 0) Then L := I + 1 Else Begin            { Item to left }
  1576.        H := I - 1;                                    { Item to right }
  1577.        If C = 0 Then Begin                            { Item match found }
  1578.          Search := True;                              { Result true }
  1579.          If NOT Duplicates Then L := I;               { Force kick out }
  1580.        End;
  1581.      End;
  1582.    End;
  1583.    Index := L;                                        { Return result }
  1584. END;
  1585.  
  1586. PROCEDURE TSortedCollection.Insert (Item: Pointer);
  1587. VAR I: Sw_Integer;
  1588. BEGIN
  1589.    If NOT Search(KeyOf(Item), I) OR Duplicates Then   { Item valid }
  1590.      AtInsert(I, Item);                               { Insert the item }
  1591. END;
  1592.  
  1593. PROCEDURE TSortedCollection.Store (Var S: TStream);
  1594. BEGIN
  1595.    TCollection.Store(S);                              { Call ancestor }
  1596.    S.Write(Duplicates, SizeOf(Duplicates));           { Write duplicate flag }
  1597. END;
  1598.  
  1599. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  1600. {▐                    TStringCollection OBJECT METHODS                     ▌}
  1601. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  1602.  
  1603. FUNCTION TStringCollection.GetItem (Var S: TStream): Pointer;
  1604. BEGIN
  1605.    GetItem := S.ReadStr;                              { Get new item }
  1606. END;
  1607.  
  1608. FUNCTION TStringCollection.Compare (Key1, Key2: Pointer): Sw_Integer;
  1609. VAR I, J: Integer; P1, P2: PString;
  1610. BEGIN
  1611.    P1 := PString(Key1);                               { String 1 pointer }
  1612.    P2 := PString(Key2);                               { String 2 pointer }
  1613.    If (Length(P1^)<Length(P2^)) Then J := Length(P1^)
  1614.      Else J := Length(P2^);                           { Shortest length }
  1615.    I := 1;                                            { First character }
  1616.    While (I<J) AND (P1^[I]=P2^[I]) Do Inc(I);         { Scan till fail }
  1617.    If (P1^[I]=P2^[I]) Then Compare := 0 Else          { Strings matched }
  1618.      If (P1^[I]<P2^[I]) Then Compare := -1 Else       { String1 < String2 }
  1619.         Compare := 1;                                 { String1 > String2 }
  1620. END;
  1621.  
  1622. PROCEDURE TStringCollection.FreeItem (Item: Pointer);
  1623. BEGIN
  1624.    DisposeStr(Item);                                  { Dispose item }
  1625. END;
  1626.  
  1627. PROCEDURE TStringCollection.PutItem (Var S: TStream; Item: Pointer);
  1628. BEGIN
  1629.    S.WriteStr(Item);                                  { Write string }
  1630. END;
  1631.  
  1632. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  1633. {▐                  TUnSortedStrCollection OBJECT METHODS                  ▌}
  1634. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  1635. PROCEDURE TUnSortedStrCollection.Insert (Item: Pointer);
  1636. BEGIN
  1637.    AtInsert(Count, Item);                             { NO sorting insert }
  1638. END;
  1639.  
  1640.  
  1641.  
  1642.  
  1643. FUNCTION TStream.Get: PObject;
  1644. BEGIN
  1645. END;
  1646.  
  1647. PROCEDURE TStream.Put (P: PObject);
  1648. BEGIN
  1649. END;
  1650.  
  1651. {***************************************************************************}
  1652. {                            INTERFACE ROUTINES                             }
  1653. {***************************************************************************}
  1654.  
  1655. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  1656. {▐                   DYNAMIC STRING INTERFACE ROUTINES                     ▌}
  1657. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  1658. FUNCTION NewStr (Const S: String): PString;
  1659. VAR P: PString;
  1660. BEGIN
  1661.    If (S = '') Then P := Nil Else Begin               { Return nil }
  1662.      GetMem(P, Length(S) + 1);                        { Allocate memory }
  1663.      If (P<>Nil) Then P^ := S;                        { Hold string }
  1664.    End;
  1665.    NewStr := P;                                       { Return result }
  1666. END;
  1667.  
  1668. PROCEDURE DisposeStr (P: PString);
  1669. BEGIN
  1670.    If (P <> Nil) Then FreeMem(P, Length(P^) + 1);     { Release memory }
  1671. END;
  1672.  
  1673. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  1674. {▐                       STREAM INTERFACE ROUTINES                         ▌}
  1675. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  1676.  
  1677. PROCEDURE Abstract;
  1678. BEGIN
  1679.    RunError(211);                                     { Abstract error }
  1680. END;
  1681.  
  1682. PROCEDURE RegisterError;
  1683. BEGIN
  1684.    RunError(212);                                     { Register error }
  1685. END;
  1686.  
  1687. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  1688. {▐                     NEW FREE VISION STREAM ROUTINES                     ▌}
  1689. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  1690.  
  1691. FUNCTION CreateStream (Strategy: Word; ReqSize: LongInt): PStream;
  1692. VAR Stream: PStream;
  1693. BEGIN
  1694.    Stream := Nil;                                     { Preset failure }
  1695.    While (Strategy <> 0) AND (Stream = Nil) Do Begin
  1696.      If (Strategy AND sa_XMSFirst <> 0) Then Begin    { ** XMS STREAM ** }
  1697.      End Else
  1698.      If (Strategy AND sa_EMSFirst <> 0) Then Begin    { ** EMS STREAM ** }
  1699.      End Else
  1700.      If (Strategy AND sa_RamFirst <> 0) Then Begin    { ** RAM STREAM ** }
  1701.      End Else
  1702.      If (Strategy AND sa_DiskFirst <> 0) Then Begin   { ** DISK STREAM ** }
  1703.      End;
  1704.      If (Stream<>Nil) AND (Stream^.Status <> stOk)    { Stream in error }
  1705.      Then Begin
  1706.        Dispose(Stream, Done);                         { Dispose stream }
  1707.        Stream := Nil;                                 { Clear pointer }
  1708.      End;
  1709.      Strategy := Strategy SHL 4;                      { Next strategy mask }
  1710.    End;
  1711.    CreateStream := Stream;                            { Return stream result }
  1712. END;
  1713.  
  1714. {▐▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▌}
  1715. {▐                    NEW FREE VISION DOS FILE ROUTINES                    ▌}
  1716. {▐▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▌}
  1717.  
  1718. {***************************************************************************}
  1719. {  DosFileOpen -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB          }
  1720. {***************************************************************************}
  1721. FUNCTION DosFileOpen (Var FileName: AsciiZ; Mode: Word): Word;
  1722. {$IFDEF NotOS2}                                       { DOS/DPMI/WINDOWS }
  1723.    {$IFDEF FPKPascal}                                 { FPK Pascal compiler }
  1724. BEGIN
  1725.    ASM
  1726.      XOR %AX, %AX;                                    { Clear error }
  1727.      MOV %AX, U_OBJECTS_DOSSTREAMERROR;
  1728.      MOVL 10(%EBP), %EDX;                             { Filename to open }
  1729.      XOR %CX, %CX;
  1730.      MOVW 8(%EBP), %AX;                               { Mode to open file }
  1731.      PUSHL %EBP;
  1732.      INT $21;                                         { Open/create the file }
  1733.      POPL %EBP;
  1734.      JNC EXIT1;
  1735.      MOV %AX, U_OBJECTS_DOSSTREAMERROR;               { Hold error }
  1736.      XOR %AX, %AX;                                    { Open failed }
  1737.    EXIT1:
  1738.      MOV %AX, U_OBJECTS_TRANSFERHANDLE;               { Hold opened handle }
  1739.    END;
  1740.    DosFileOpen := TransferHandle;                     { Return handle }
  1741. END;
  1742.    {$ELSE}                                            { Other compilers }
  1743. ASSEMBLER;
  1744.    ASM
  1745.      XOR AX, AX;                                      { Dos error cleared }
  1746.      MOV DosStreamError, AX;
  1747.      MOV AX, Mode;                                    { Mode to open file }
  1748.      PUSH DS;
  1749.      LDS DX, FileName;                                { Filename to open }
  1750.      XOR CX, CX;
  1751.      INT $21;                                         { Open/create file }
  1752.      POP DS;
  1753.      JNC @@Exit1;                                     { Check for error }
  1754.      MOV DosStreamError, AX;
  1755.      XOR AX, AX;                                      { Open fail return 0 }
  1756.    @@Exit1:
  1757.    END;
  1758.    {$ENDIF}
  1759. {$ELSE}                                               { OS2 CODE }
  1760. VAR Attr, OpenFlags, OpenMode: Word; Success, Handle, ActionTaken: Sw_Word;
  1761. BEGIN
  1762.    Case Mode Of
  1763.      stCreate: Begin                                  { Create file }
  1764.          Attr := $20;                                 { Archive file }
  1765.          OpenFlags := 18;                             { Open flags }
  1766.          OpenMode := FmInOut;                         { Input/output file }
  1767.        End;
  1768.      stOpenRead: Begin                                { Open file for read }
  1769.          Attr := $0;                                  { Any attributes }
  1770.          OpenFlags := 1;                              { Open flags }
  1771.          OpenMode := FmInput;                         { Input file }
  1772.        End;
  1773.      stOpenWrite: Begin                               { Open file for write }
  1774.          Attr := $0;                                  { Any attributes }
  1775.          OpenFlags := 1;                              { Open flags }
  1776.          OpenMode := FmOutput;                        { Output file }
  1777.        End;
  1778.      stOpen: Begin                                    { Open file read/write }
  1779.          Attr := $0;                                  { Any attributes }
  1780.          OpenFlags := 1;                              { Open flags }
  1781.          OpenMode := FmInOut;                         { Input/output file }
  1782.        End;
  1783.    End;
  1784.    {$IFDEF Speed}                                     { Speed pascal differs }
  1785.    DosStreamError := DosOpen(CString(FileName), Handle,
  1786.    {$ELSE}                                            { Other OS2 compilers }
  1787.    DosStreamError := DosOpen(@FileName[0], Handle,
  1788.    {$ENDIF}
  1789.      ActionTaken, 0, Attr, OpenFlags, OpenMode, Nil); { Open the file }
  1790.    If (DosStreamError=0) Then DosFileOpen := Handle   { Successful open }
  1791.      Else DosFileOpen := 0;                           { Fail so return zero }
  1792. END;
  1793. {$ENDIF}
  1794.  
  1795. {$IFDEF NotOS2}                                       { DOS/DPMI/WINDOWS }
  1796. {***************************************************************************}
  1797. {  DosRead -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB                  }
  1798. {***************************************************************************}
  1799. FUNCTION DosRead (Handle: Word; Var BufferArea; BufferLength: Sw_Word;
  1800. Var BytesMoved: Sw_Word): Word;
  1801. {$IFDEF FPKPascal}                                    { FPK pascal compiler }
  1802. BEGIN
  1803.    ASM
  1804.      MOVL 14(%EBP), %EDX;                             { Buffer for data }
  1805.      MOVL 12(%EBP), %CX;                              { Bytes to read }
  1806.      MOVB $3F, %AH;
  1807.      MOVW 18(%EBP), %BX;                              { Load file handle }
  1808.      PUSHL %EBP;
  1809.      INT $21;                                         { Read from file }
  1810.      POPL %EBP;
  1811.      JC EXIT2;                                        { Check for error }
  1812.      MOVL 8(%EBP), %EDI;
  1813.      MOVW %AX, %BX;
  1814.      XOR %EAX, %EAX;                                  { Clear register }
  1815.      MOVW %BX, %AX;
  1816.      MOVL %EAX, (%EDI);                               { Update bytes moved }
  1817.      XOR %EAX, %EAX;
  1818.    EXIT2:
  1819.      MOV %AX, U_OBJECTS_DOSSTREAMERROR;               { DOS error returned }
  1820.    END;
  1821.    DosRead := DosStreamError;                         { Return any error }
  1822. END;
  1823. {$ELSE}                                               { Other compilers }
  1824. ASSEMBLER;
  1825.    ASM
  1826.      PUSH DS;
  1827.      LDS DX, BufferArea;                              { Data dest buffer }
  1828.      MOV CX, BufferLength;
  1829.      MOV BX, Handle;                                  { Load file handle }
  1830.      MOV AH, $3F;
  1831.      INT $21;                                         { Read from file }
  1832.      POP DS;
  1833.      JC @@Exit2;                                      { Check for error }
  1834.      LES DI, BytesMoved;
  1835.      MOV ES:[DI], AX;                                 { Update bytes moved }
  1836.      XOR AX, AX;
  1837.    @@Exit2:
  1838.      MOV DosStreamError, AX;                          { DOS error returned }
  1839.    END;
  1840. {$ENDIF}
  1841.  
  1842. {***************************************************************************}
  1843. {  DosWrite -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB                 }
  1844. {***************************************************************************}
  1845. FUNCTION DosWrite (Handle: Word; Var BufferArea; BufferLength: Sw_Word;
  1846. Var BytesMoved: Sw_Word): Word;
  1847. {$IFDEF FPKPascal}                                    { FPK pascal compiler }
  1848. BEGIN
  1849.    ASM
  1850.      MOVL 14(%EBP), %EDX;                             { Buffer with data }
  1851.      MOVL 12(%EBP), %CX;                              { Bytes to write }
  1852.      MOVB $40, %AH;
  1853.      MOVW 18(%EBP), %BX;                              { Load file handle }
  1854.      PUSHL %EBP;
  1855.      INT $21;                                         { Write to file }
  1856.      POPL %EBP;
  1857.      JC EXIT3;                                        { Check for error }
  1858.      MOVL 8(%EBP), %EDI;
  1859.      MOVW %AX, %BX;
  1860.      XOR %EAX, %EAX;                                  { Clear register }
  1861.      MOVW %BX, %AX;
  1862.      MOVL %EAX, (%EDI);                               { Update bytes moved }
  1863.      XOR %EAX, %EAX;
  1864.    EXIT3:
  1865.      MOV %AX, U_OBJECTS_DOSSTREAMERROR;               { DOS error returned }
  1866.    END;
  1867.    DosWrite := DosStreamError;                        { Return any error }
  1868. END;
  1869. {$ELSE}                                               { Other compilers }
  1870. ASSEMBLER;
  1871.    ASM
  1872.      PUSH DS;
  1873.      LDS DX, BufferArea;                              { Data source buffer }
  1874.      MOV CX, BufferLength;
  1875.      MOV BX, Handle;                                  { Load file handle }
  1876.      MOV AH, $40;
  1877.      INT $21;                                         { Write to file }
  1878.      POP DS;
  1879.      JC @@Exit3;                                      { Check for error }
  1880.      LES DI, BytesMoved;
  1881.      MOV ES:[DI], AX;                                 { Update bytes moved }
  1882.      XOR AX, AX;
  1883.    @@Exit3:
  1884.      MOV DosStreamError, AX;                          { DOS error returned }
  1885.    END;
  1886. {$ENDIF}
  1887.  
  1888. {***************************************************************************}
  1889. {  DosSetFilePtr -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB            }
  1890. {***************************************************************************}
  1891. FUNCTION DosSetFilePtr (Handle: Word; Pos: LongInt; MoveType: Word;
  1892. VAR NewPos: LongInt): Word;
  1893. {$IFDEF FPKPascal}                                    { FPK pascal compiler }
  1894. BEGIN
  1895.    ASM
  1896.      MOVW 12(%EBP), %AX;                              { Load move type }
  1897.      MOVB $42, %AH;
  1898.      MOVW 14(%EBP), %DX;                              { Load file position }
  1899.      MOVW 16(%EBP), %CX;
  1900.      MOVW 18(%EBP), %BX;                              { Load file handle }
  1901.      PUSHL %EBP;
  1902.      INT $21;                                         { Position the file }
  1903.      POPL %EBP;
  1904.      JC EXIT4;
  1905.      MOVL 8(%EBP), %EDI;                              { New position address }
  1906.      MOVW %AX, %BX;
  1907.      MOVW %DX, %AX;
  1908.      SHL $10, %EAX;                                   { Roll to high part }
  1909.      MOVW %BX, %AX;
  1910.      MOVL %EAX, (%EDI);                               { Update new position }
  1911.      XOR %EAX, %EAX;
  1912.    EXIT4:
  1913.      MOVW %AX, U_OBJECTS_DOSSTREAMERROR;              { DOS error returned }
  1914.    END;
  1915.    DosSetFilePtr := DosStreamError;                   { Return any error }
  1916. END;
  1917. {$ELSE}                                               { Other compilers }
  1918. ASSEMBLER;
  1919.    ASM
  1920.      MOV AX, MoveType;                                { Load move type }
  1921.      MOV AH, $42;
  1922.      MOV DX, Pos.Word[0];                             { Load file position }
  1923.      MOV CX, Pos.Word[2];
  1924.      MOV BX, Handle;                                  { Load file handle }
  1925.      INT $21;                                         { Position the file }
  1926.      JC @@Exit4;
  1927.      LES DI, NewPos;                                  { New position address }
  1928.      MOV ES:[DI], AX;
  1929.      MOV ES:[DI+2], DX;                               { Update new position }
  1930.      XOR AX, AX;
  1931.    @@Exit4:
  1932.      MOV DosStreamError, AX;                          { DOS error returned }
  1933.    END;
  1934. {$ENDIF}
  1935.  
  1936. {***************************************************************************}
  1937. {  DosClose -> Platforms DOS/DPMI/WIN - Checked 16May96 LdB                 }
  1938. {***************************************************************************}
  1939. PROCEDURE DosClose (Handle: Word);
  1940. {$IFDEF FPKPascal}                                    { FPK pascal compiler }
  1941. BEGIN
  1942.    ASM
  1943.      XOR %AX, %AX;
  1944.      MOVW %AX, U_OBJECTS_DOSSTREAMERROR;              { DOS error cleared }
  1945.      MOVB $3E, %AH;
  1946.      MOVW 8(%EBP), %BX;                               { DOS file handle }
  1947.      PUSHL %EBP;
  1948.      INT $21;                                         { Close the file }
  1949.      POPL %EBP;
  1950.      JNC EXIT5;
  1951.      MOVW %AX, U_OBJECTS_DOSSTREAMERROR;              { DOS error returned }
  1952.    EXIT5:
  1953.    END;
  1954. END;
  1955. {$ELSE}                                               { Other compilers }
  1956. ASSEMBLER;
  1957.    ASM
  1958.      XOR AX, AX;                                      { DOS error cleared }
  1959.      MOV DosStreamError, AX;
  1960.      MOV BX, Handle;                                  { DOS file handle }
  1961.      MOV AH, $3E;
  1962.      INT $21;                                         { Close the file }
  1963.      JNC @@Exit5;
  1964.      MOV DosStreamError, AX;                          { DOS error returned }
  1965.    @@Exit5:
  1966.    END;
  1967. {$ENDIF}
  1968.  
  1969. {$ENDIF}
  1970.  
  1971. END.
  1972.